home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1997 January / macformat46.iso / Shareware Plus / Developers / ASTcl 1.0 / ASTcl-1.0 / ASTkMacAppInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-09-28  |  8.1 KB  |  355 lines
  1. /*
  2.  * ASTcl -- DoAppleScript package for MacTcl 7.5.1
  3.  * This code adds the command "DoAppleScript <script>" to MacTcl.
  4.  *
  5.  * ASTkMacAppInit.c -- 
  6.  *    Provides a version of the Tcl_AppInit procedure for the example shell.
  7.  * Written on 960927.
  8.  * 
  9.  * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
  10.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  11.  *
  12.  * See the file "license.terms" for information on usage and redistribution
  13.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14.  *
  15.  * modified by Theodore C. Belding
  16.  * University of Michigan Program for the Study of Complex Systems
  17.  * <mailto:Ted.Belding@umich.edu>
  18.  * <http://www-personal.engin.umich.edu>
  19.  * 
  20.  */
  21.  
  22. #include <Windows.h>
  23. #include <Gestalt.h>
  24. #include <ToolUtils.h>
  25. #include <Fonts.h>
  26. #include <Dialogs.h>
  27. #include <Memory.h>
  28. #include <SegLoad.h>
  29.  
  30. #include "tk.h"
  31. #include "tkInt.h"
  32. #include "tkMacInt.h"
  33.  
  34. #include "ASTcl.h"
  35.  
  36. #ifdef TK_TEST
  37. EXTERN int        Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  38. #endif /* TK_TEST */
  39.  
  40. typedef int (*TclMacConvertEventPtr) _ANSI_ARGS_((EventRecord *eventPtr));
  41. Tcl_Interp *gStdoutInterp = NULL;
  42.  
  43. void     TclMacSetEventProc _ANSI_ARGS_((TclMacConvertEventPtr procPtr));
  44. int     TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));
  45.  
  46. /*
  47.  * Prototypes for functions the ANSI library needs to link against.
  48.  */
  49. short            InstallConsole _ANSI_ARGS_((short fd));
  50. void            RemoveConsole _ANSI_ARGS_((void));
  51. long            WriteCharsToConsole _ANSI_ARGS_((char *buff, long n));
  52. long            ReadCharsFromConsole _ANSI_ARGS_((char *buff, long n));
  53. extern char *        __ttyname _ANSI_ARGS_((long fildes));
  54. short            SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
  55.  
  56. /*
  57.  * Forward declarations for procedures defined later in this file:
  58.  */
  59.  
  60. static int        MacintoshInit _ANSI_ARGS_((void));
  61. static int        SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp));
  62.  
  63. /*
  64.  *----------------------------------------------------------------------
  65.  *
  66.  * main --
  67.  *
  68.  *    Main program for Wish.
  69.  *
  70.  * Results:
  71.  *    None. This procedure never returns (it exits the process when
  72.  *    it's done
  73.  *
  74.  * Side effects:
  75.  *    This procedure initializes the wish world and then 
  76.  *    calls Tk_Main.
  77.  *
  78.  *----------------------------------------------------------------------
  79.  */
  80.  
  81. void
  82. main(argc, argv)
  83.     int argc;                /* Number of arguments. */
  84.     char **argv;            /* Array of argument strings. */
  85. {
  86.     char *newArgv[2];
  87.  
  88.     if (MacintoshInit()  != TCL_OK) {
  89.     Tcl_Exit(1);
  90.     }
  91.  
  92.     argc = 1;
  93.     newArgv[0] = "Wish";
  94.     newArgv[1] = NULL;
  95.     Tk_Main(argc, newArgv, Tcl_AppInit);
  96. }
  97.  
  98. /*
  99.  *----------------------------------------------------------------------
  100.  *
  101.  * Tcl_AppInit --
  102.  *
  103.  *    This procedure performs application-specific initialization.
  104.  *    Most applications, especially those that incorporate additional
  105.  *    packages, will have their own version of this procedure.
  106.  *
  107.  * Results:
  108.  *    Returns a standard Tcl completion code, and leaves an error
  109.  *    message in interp->result if an error occurs.
  110.  *
  111.  * Side effects:
  112.  *    Depends on the startup script.
  113.  *
  114.  *----------------------------------------------------------------------
  115.  */
  116.  
  117. int
  118. Tcl_AppInit(interp)
  119.     Tcl_Interp *interp;        /* Interpreter for application. */
  120. {
  121.     if (Tcl_Init(interp) == TCL_ERROR) {
  122.     return TCL_ERROR;
  123.     }
  124.     if (Tk_Init(interp) == TCL_ERROR) {
  125.     return TCL_ERROR;
  126.     }
  127.     Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
  128.     
  129.     /*
  130.      * Call the init procedures for included packages.  Each call should
  131.      * look like this:
  132.      *
  133.      * if (Mod_Init(interp) == TCL_ERROR) {
  134.      *     return TCL_ERROR;
  135.      * }
  136.      *
  137.      * where "Mod" is the name of the module.
  138.      */
  139.  
  140.     if (ASTcl_Init(interp)==TCL_ERROR) {
  141.         return TCL_ERROR;
  142.     }
  143.  
  144. #ifdef TK_TEST
  145.     if (Tktest_Init(interp) == TCL_ERROR) {
  146.     return TCL_ERROR;
  147.     }
  148.     Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
  149.             (Tcl_PackageInitProc *) NULL);
  150. #endif /* TK_TEST */
  151.  
  152.     /*
  153.      * Call Tcl_CreateCommand for application-specific commands, if
  154.      * they weren't already created by the init procedures called above.
  155.      */
  156.  
  157.     SetupMainInterp(interp);
  158.  
  159.     /*
  160.      * Specify a user-specific startup file to invoke if the application
  161.      * is run interactively.  On the Mac we can specifiy that this file
  162.      * is in the application's resource fork.  A traditional file location
  163.      * may also be used.
  164.      */
  165.  
  166.     Tcl_Eval(interp, "source -rsrc {tclshrc}");
  167.     Tcl_ResetResult(interp);
  168.  
  169.     /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
  170.     return TCL_OK;
  171. }
  172.  
  173. /*
  174.  *----------------------------------------------------------------------
  175.  *
  176.  * MacintoshInit --
  177.  *
  178.  *    This procedure calls Mac specific initilization calls.  Most of
  179.  *    these calls must be made as soon as possible in the startup
  180.  *    process.
  181.  *
  182.  * Results:
  183.  *    Returns TCL_OK if everything went fine.  If it didn't the 
  184.  *    application should probably fail.
  185.  *
  186.  * Side effects:
  187.  *    Inits the application.
  188.  *
  189.  *----------------------------------------------------------------------
  190.  */
  191.  
  192. static int
  193. MacintoshInit()
  194. {
  195.     int i;
  196.     long result, mask = 0x0700;         /* mask = system 7.x */
  197.     
  198.     InitGraf(&qd.thePort);
  199.     InitFonts();
  200.     InitWindows();
  201.     InitMenus();
  202.     InitDialogs((long) NULL);        
  203.     InitCursor();
  204.  
  205.     /*
  206.      * Make sure we are running on system 7 or higher
  207.      */
  208.     if (((Gestalt(gestaltSystemVersion, &result) != noErr)
  209.         && (mask == (result & mask)))) {
  210.     panic("Tcl/Tk requires system 7 or higher.");
  211.     }
  212.  
  213.     /*
  214.      * Make sure we have color quick draw 
  215.      * (this means we can't run on 68000 macs)
  216.      */
  217.     if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr)
  218.         && (result < gestalt8BitQD))) {
  219.     panic("Tk requires color quickdraw.");
  220.     }
  221.  
  222.     
  223.     FlushEvents(everyEvent, 0);
  224.     SetEventMask(everyEvent);
  225.  
  226.     /*
  227.      * Set up stack & heap sizes
  228.      */
  229.     /* TODO: stack size
  230.        size = StackSpace();
  231.        SetAppLimit(GetAppLimit() - 8192);
  232.      */
  233.     MaxApplZone();
  234.     for (i = 0; i < 4; i++) {
  235.     (void) MoreMasters();
  236.     }
  237.  
  238.     TclMacSetEventProc(TkMacConvertEvent);
  239.     TkConsoleCreate();
  240.  
  241.     return TCL_OK;
  242. }
  243.  
  244. /*
  245.  *----------------------------------------------------------------------
  246.  *
  247.  * SetupMainInterp --
  248.  *
  249.  *    This procedure calls initalization routines require a Tcl 
  250.  *    interp as an argument.  This call effectively makes the passed
  251.  *    iterpreter the "main" interpreter for the application.
  252.  *
  253.  * Results:
  254.  *    Returns TCL_OK if everything went fine.  If it didn't the 
  255.  *    application should probably fail.
  256.  *
  257.  * Side effects:
  258.  *    More initilization.
  259.  *
  260.  *----------------------------------------------------------------------
  261.  */
  262.  
  263. static int
  264. SetupMainInterp(interp)
  265.     Tcl_Interp *interp;
  266. {
  267.     /*
  268.      * Initialize the console only if we are running as an interactive
  269.      * application.
  270.      */
  271.  
  272.     if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
  273.         == 0) {
  274.     if (TkConsoleInit(interp) == TCL_ERROR) {
  275.     goto error;
  276.     }
  277.     }
  278.  
  279.     TkMacInitAppleEvents(interp);
  280.     TkMacInitMenus(interp);
  281.     
  282.     /*
  283.      * Attach the global interpreter to tk's expected global console
  284.      */
  285.     gStdoutInterp = interp;
  286.  
  287.     return TCL_OK;
  288.  
  289. error:
  290.     panic(interp->result);
  291.     return TCL_ERROR;
  292. }
  293.  
  294. /*
  295.  *----------------------------------------------------------------------
  296.  *
  297.  * InstallConsole, RemoveConsole, etc. --
  298.  *
  299.  *    The following functions provide the UI for the console package.
  300.  *    Users wishing to replace SIOUX with their own console package 
  301.  *    need only provide the four functions below in a library.
  302.  *
  303.  * Results:
  304.  *    See SIOUX documentation for details.
  305.  *
  306.  * Side effects:
  307.  *    See SIOUX documentation for details.
  308.  *
  309.  *----------------------------------------------------------------------
  310.  */
  311.  
  312. short 
  313. InstallConsole(short fd)
  314. {
  315. #pragma unused (fd)
  316.  
  317.     return 0;
  318. }
  319.  
  320. void 
  321. RemoveConsole(void)
  322. {
  323. }
  324.  
  325. long 
  326. WriteCharsToConsole(char *buffer, long n)
  327. {
  328.     TkConsolePrint(gStdoutInterp, NULL, buffer, n);
  329.     return n;
  330. }
  331.  
  332. long 
  333. ReadCharsFromConsole(char *buffer, long n)
  334. {
  335.     return 0;
  336. }
  337.  
  338. extern char *
  339. __ttyname(long fildes)
  340. {
  341.     static char *__devicename = "null device";
  342.  
  343.     if (fildes >= 0 && fildes <= 2) {
  344.     return (__devicename);
  345.     }
  346.     
  347.     return (0L);
  348. }
  349.  
  350. short
  351. SIOUXHandleOneEvent(EventRecord *event)
  352. {
  353.     return 0;
  354. }
  355.